Nautilus 1993 March/Nautilus-4-3/Nautilus-4-3.bin/Multimedia/Feature/Image 1.47 Folder/Macros/Measurement Macros

Text File | 1992-07-31 | 8.5 KB | 399 lines

macro 'Count Particles at Random Locations';
var
  n,i,width,height,PicID,nLocations:integer;
  size:real;
begin
  RequiresVersion(1.44);
  nLocations:=10;
  size:=0.25;
  n:=1;
  GetPicSize(width,height);
  PicID:=PicNumber;
  SetUser1Label('Count');
  SetOptions('User1');
  for i:=1 to nLocations do begin
    SelectPic(PicID);
    MakeRoi((1-size)*width*random,(1-size)*height*random,size*width,size*height);
    Duplicate('Temp');;
    SetDensitySlice(255,255);
    AnalyzeParticles;
    Dispose;
    rUser1[i]:=rCount;
  end;
  KillRoi;
  SetCounter(nLocations);
  ShowResults;
end;


macro 'Make Circle from Line';
var
  x1,x2,y1,y2,top,left,width,height:integer;
  xcenter,ycenter,radius:integer;
begin
  GetLine(x1,y1,x2,y2,width);
  if x1<0 then begin
    PutMessage('This macro requires a line selection.');
    exit;
  end;
  xcenter:=x1+(x2-x1)/2;
  ycenter:=y1+(y2-y1)/2;
  radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2);
end;


macro 'Display Calibration Table';
{
Stores 0-255(all possible gray values) in the User1 column
and the 256 corresponding calibrated values in the User2 column.
Max Measurements must be set to 256 or greater. Use the Export
command to export the calibration table to a text file. The two
columns will be identical if the image is not calibrated.
}
var
  i:integer;
  v:real;
begin
  RequiresVersion(1.44);
  SetCounter(256);
  SetUser1Label('value');
  SetUser2Label('cvalue');
  for i:=0 to 255 do begin
    rUser1[i+1]:=i;
    rUser2[i+1]:=cvalue(i);
  end;
  ShowResults;
end;


macro 'Measure and draw line [L]';
var
  x1,x2,y1,y2,width:integer;
begin
  GetLine(x1,y1,x2,y2,width);
  if x1<0 then begin
    PutMessage('This macro requires a line selection.');
    exit;
  end;
  Measure;
  Fill;
  KillRoi;
end;


macro 'Measure All';
{Measures all currently open images using the current selection. There is}
{an implied "Select All" if the active image doesn't have a selection.}
var
  i,left,top,width,height:integer;
begin
  ResetCounters;
  for i:=1 to nPics do begin
    SelectPic(i);
    RestoreROI;
    Measure;
  end;
end;


macro 'Measure All from Disk';
{
Reads from disk and measures a set of images too large to simultaneously
fit in memory. The image names names must be in the form '01', '02', etc.
Before starting, open and outline the first image('01').
}
var
  i,width,height:integer;
begin
  GetPicSize(width,height);
  if width=0 then begin
    PutMessage('Before running this macro, open and outline the first image("01") in the series.');
    exit;
  end;
  ResetCounters;
  Measure;
  close;
  for i:=2 to 1000 do begin
    open(i:2);
    RestoreROI;
    Measure;
    close;
  end;
end;


macro 'Paste Results [P]'
{Use the Measure command, the ruler tool, or the pointing tool to}
{make up to about 10 measurements, then use this macro to paste}
{the results into the upper left corner of the window.}
begin
  SetFont('Monaco');
  SetFontSize(9);
  SetText('Plain; Align Left');
  SetOption; {Copy headings}
  CopyResults;
  MakeRoi(-10,0,250,150);
  Paste;
  KillRoi;
  ResetCounter;
end;


macro 'Measure Redirected and Label'
begin
  Redirect(true);
  Measure;
  Redirect(false);
  MarkSelection;
  RestoreRoi;
end;


macro 'Reset Measurement Options';
{Resets the Options dialog box in the Analyze menu to the default settings.}
begin
  RequiresVersion(1.44);
  SetOptions('Area; Mean');
  Redirect(false);
  LabelParticles(true);
  OutlineParticles(false);
  IgnoreParticlesTouchingEdge(false);
  IncludeInteriorHoles(false);
  WandAutoMeasure(false);
  AdjustAreas(false);
  SetParticleSize(1,999999);
  SetPrecision(2);
end;


macro 'Set Threshold';
var
  lower,upper:integer;
begin
  lower:=GetNumber('Lower:',1);
  upper:=GetNumber('Upper:',254);
  SetDensitySlice(lower,upper);
end;


macro 'Measure Accumulated Perimeter[A]';
{
Measures perimeter and computes accumulated perimeter,
storing it in the User1 column.
}
var
  i:integer;
  Total:real;
begin
  MeasurePerimeter(true);
  SetOptions('Area; Mean; Perimeter; User1');
  SetUser1Label('Total');
  Measure;
  Total:=0;
  for i:=1 to rCount do Total:=Total+rLength[i];
  rUser1[rCount]:=Total;
  UpdateResults;
end;


macro 'Count Black and White Pixels [B]';
{
Counts the number of black and white pixels in the current
selection and stores the counts in the User1 and User2 columns.
}
begin
  RequiresVersion(1.44);
  SetUser1Label('Black');
  SetUser2Label('White');
  Measure;
  rUser1[rCount]:=histogram[255];
  rUser2[rCount]:=histogram[0];
  UpdateResults;
end;


macro 'Compute Average and Total Area [T]';
{
Computes average and accumulated area and stores
the them in the Major and Minor Axis columns.
}
var
  i:integer;
  sum:real;
begin
  RequiresVersion(1.44);
  SetUser1Label('Avg');
  SetUser2Label('Total');
  SetOptions('Area; User1; User2');
  Measure;
  sum:=0;
  for i:=1 to rCount do sum:=sum+rArea[i];
  rUser1[rCount]:=sum/rCount;
  rUser2[rCount]:=sum;
  UpdateResults;
end;


macro 'Measure Circularity';
begin
  SetUser1Label('Shape');
  Measure;
  rUser1[rCount]:=4*3.14159265*(rArea[rCount]/sqr(rLength[rCount]));
  UpdateResults;
end;


macro 'Fit  Ellipse and Draw in White';
var
  left,top,width,height:real;
begin
  GetRoi(left,top,width,height);
  if width=0 then begin
    PutMessage('This macro requires a selection.');
    exit;
  end;
  SetOptions('Area; Mean; X-Y Center');
  Measure;
  SetOption; MarkSelection;
  KillRoi;
  SelectAll;
  KillRoi;
 end;


macro 'Draw XY Center';
var
  left,top,width,height,x,y:real;
begin
  RequiresVersion(1.44);
  GetRoi(left,top,width,height);
  if width=0 then begin
    PutMessage('This macro requires a selection.');
    exit;
  end;
  SaveState; {Invert Y status saved starting with V1.44b21}
  InvertY(false);
  SetForegroundColor(255); {black}
  SetOptions('Area; Mean; X-Y Center'); {XY Center}
  Measure;
  KillRoi;
  x:=rX[rCount];
  y:=rY[rCount];
  MoveTo(x-5,y);
  LineTo(x+5,y);
  MoveTo(x,y-5);
  LineTo(x,y+5);
  RestoreState;
end;


macro 'Plot Radial Density Profiles [R]';
var
  x1,y1,x2,y2,pi,angle,delta:real;
  LineWidth,i,nLines,radius,PlotWidth,PlotHeight:integer;
  MinPlotWidth,hMargin,vMargin,PlotLeft,PlotTop:integer;
  LeftMargin,RightMargin,TopMargin,BottomMargin:integer;
  ImageWindow,PlotWindow:integer;
  nPixels,mean,mode,min,max:real;
begin
  RequiresVersion(1.45);
  SaveState;
  GetLine(x1,y1,x2,y2,LineWidth)
  if x1<0 then begin
    PutMessage('Please select a point by clicking with the line tool.');
    exit;
  end;
  radius:=20;
  nLines:=8;
  MinPlotWidth:=140;
  pi:=3.14159;
  delta:=2.0*pi/nLines;
  angle:=0.0;
  PlotWidth:=radius;
  if PlotWidth<MinPlotWidth then PlotWidth:=MinPlotWidth;
  PlotHeight:=0.4*PlotWidth;
  SetPlotSize(PlotWidth,PlotHeight);
  MakeOvalRoi(x1-radius,y1-radius,radius*2,radius*2);
  Measure;
  GetResults(nPixels,mean,mode,min,max);
  min:=min-10;
  if min<0 then min:=0;
  max:=max+10;
  if max>255 then max:=255;
  SetPlotScale(cValue(min),cValue(max));
  SetPlotLabels(false);
  hMargin:=5;
  vMargin:=5;
  if Calibrated
    then LeftMargin:=35
    else LeftMargin:=25;
  TopMargin:=10;
  RightMargin:=10;
  BottomMargin:=20;
  PlotLeft:=hMargin-LeftMargin;
  PlotTop:=vMargin-TopMargin;
  SetNewSize(PlotWidth+2*hMargin,PlotHeight*nLines);
  SetForegroundColor(255);
  SetBackgroundColor(0);
  ImageWindow:=PicNumber;
  MakeNewWindow('Plots');
  PlotWindow:=PicNumber;
  SelectPic(ImageWindow);
  for i:=1 TO nLines do begin
    x2:=x1+round(radius*cos(angle));
    y2:=y1+round(radius*sin(angle));
    MakeLineRoi(x1,y1,x2,y2);
    PlotProfile;
    Copy;
    SelectPic(PlotWindow);
    MakeRoi(PlotLeft,PlotTop,PlotWidth+LeftMargin+RightMargin,
          PlotHeight+TopMargin+BottomMargin);
    Paste;
    DoOr;
    PlotTop:=PlotTop+PlotHeight-1;
    SelectPic(ImageWindow);
    angle:=angle+delta;
  end;
  RestoreState;
end;


macro 'Circular Profile Plot [C]';
var
  radius,pi,angle,dx,dy,delta:real;
  x1,y1,x2,y2:real;
  npoints,i,value,LineWidth,x,y,px:integer;
begin
  GetLine(x1,y1,x2,y2,LineWidth)
  if x1<0 then begin
    PutMessage('Please select a point by clicking with the line tool.');
    exit;
  end;
  x:=x1+(x2-x1)/2;
  y:=y1+(y2-y1)/2;
  radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  if radius<3 then begin
    PutMessage('The line selection must be longer than 5 pixels.');
    exit;
  end;
  npoints:=radius*2;
  pi:=3.14159;
  delta:=2.0*pi/npoints;
  angle:=0.0;
  px:=0;
  for i:=1 TO npoints do begin
    dx:=round(radius*cos(angle));
    dy:=round(radius*sin(angle));
    value:=GetPixel(x+dx,y+dy);
    PutPixel(x+dx,y+dy,255);
    PutPixel(px,0,value);
    px:=px+1;
    angle:=angle+delta;
  end;
  MakeLineRoi(0,0,npoints,0);
  PlotProfile;
  KillRoi;
end;